home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 8 / Amoszine 8 (Disk 2 of 3).adf / Powerbobs.lha / powerbobsv1.0 / demos / PopCorn.asc < prev    next >
Text File  |  1995-06-30  |  5KB  |  192 lines
  1. ' Program : Popcorn  
  2. ' Author  : Paul Overy 
  3. '
  4. ' POWERBOBS EXTENSION NEEDED.
  5. '
  6. ' Once AmosBanK (.abk) is loaded:-     
  7. '    -- Bank 14 : Holds large logo.      
  8. '    -- Bank 15 : Stores all gfx for bobs.     
  9. '
  10. ' This program does not use any floating point calculations!   
  11. '
  12. '
  13. Dim MX(64),MY(64),X(64),Y(64),FRM(64)
  14. Dim DISPLAY_X(64),DISPLAY_Y(64),DISPLAY_FRM(64)
  15. Global _BOB_SIZE,_BOBS
  16. '
  17. '------------------------------------- 
  18. Load "PowerBobsV1.0:DEMOS/PopCorn.Abk"
  19. '-------------------------------------   
  20. '
  21. Proc _SET_UP
  22. Proc _CUT_BOBS
  23. '
  24. Break Off 
  25. NULL=Execall(-132) : Rem -- Turn off multitasking 
  26. '
  27. '-- Pre-store some of the starting address to arrays 
  28. '
  29. _FRM=Varptr(FRM(0))
  30. _Y=Varptr(Y(0))
  31. _X=Varptr(X(0))
  32. _MY=Varptr(MY(0))
  33. _MX=Varptr(MX(0))
  34. _DX=Varptr(DISPLAY_X(0))
  35. _DY=Varptr(DISPLAY_Y(0))
  36. _DFRM=Varptr(DISPLAY_FRM(0))
  37. _CX=Varptr(X(_BOBS))
  38. _CY=Varptr(Y(_BOBS))
  39. _CFRM=Varptr(FRM(_BOBS))
  40. '
  41. Dec _BOBS : Rem Adjust total, arrays start at 0. 
  42. '
  43. '-- Set ball frames, and falling speed.
  44. '
  45. For K=0 To _BOBS
  46.    FRM(K)=4
  47.    MY(K)=-(320-K*32)
  48.    '   Set Pbob K+1,0,%1000 : Rem Try using this line for more speed    
  49. Next K
  50. '----------------------------------------------------------------------- 
  51. '
  52. '-- Main start 
  53. '
  54. Repeat 
  55.    '
  56.    Pinc _FRM,0 To _BOBS : Rem   -- Update all ball images      
  57.    Padd _MY,16,0 To _BOBS : Rem -- Change falling speed
  58.    Psum _Y,_MY,0 To _BOBS : Rem -- Calculate all new Y       
  59.    Psum _X,_MX,0 To _BOBS : Rem -- Calculate all new X       
  60.    '
  61.    Copy _X,_CX To _DX
  62.    Copy _Y,_CY To _DY
  63.    Copy _FRM,_CFRM To _DFRM
  64.    '
  65.    Plsr _DX,5,0 To _BOBS : Rem scale array  /32 
  66.    Plsr _DY,5,0 To _BOBS : Rem scale array  /32 
  67.    Plsr _DFRM,2,0 To _BOBS : Rem scale array /4 
  68.    '
  69.    '-- Reset all values if ball is outside screen area  
  70.    '-- Values are scaled up, saves on using floating point values 
  71.    '
  72.    For K=0 To _BOBS
  73.       If Y(K)>8192 : Rem Y > 256 scaled up by 32. 
  74.          X(K)=5120 : Rem 160 scaled up by 32  
  75.          '-- reset starting point 
  76.          Y(K)=8472-(_BOB_SIZE*32)
  77.          MX(K)=Rnd(320)-160 : MY(K)=-(320+Rnd(192))
  78.          FRM(K)=4
  79.       End If 
  80.    Next K
  81.    '
  82.    Pbob _DX,_DY,_DFRM,1 To _BOBS+1 : Rem -- Re-position all bobs  
  83.    Pbob Update : Rem -- clear old bobs & draw new ones  
  84.    '
  85.    Screen Swap : Wait Vbl 
  86.    '
  87. Until Not Btst(6,$BFE001) : Rem -- Test for right mouse  
  88. '
  89. NULL=Execall(-138) : Rem -- Turn on multitasking  
  90. Break On 
  91. '
  92. '-- Main End 
  93. '----------------------------------------------------------------------- 
  94. '
  95. '
  96. Procedure _CUT_BOBS
  97.    '
  98.    Unpack 15 To 0 : Rem Get graphics from bank 
  99.    '
  100.    N=1 : Rem Bob image counter
  101.    '
  102.    If _BOB_SIZE=32
  103.       '
  104.       '-- Cut out large bobs 
  105.       '
  106.       For Y=0 To 32 Step 32
  107.          For X=0 To 288 Step 32
  108.             Get Bob N,X,Y To X+32,Y+30 : Inc N
  109.          Next X
  110.       Next Y
  111.    Else 
  112.       '
  113.       '-- Cut out small bobs 
  114.       '  
  115.       For X=0 To 256 Step 16
  116.          Get Bob N,X,Y+64 To X+16,Y+79 : Inc N
  117.       Next X
  118.    End If 
  119.    '
  120.    Hide : Curs Off : Pen 15 : Paper 0 : Cls 0 : Centre "Left mouse stops"
  121.    '
  122.    '-- Set up screen buffering to stop flicker  
  123.    '
  124.    Unpack 14 To 0 : Rem      -- Get logo screen
  125.    Double Buffer : Rem       -- Screen buffering to stop flicker    
  126.    Autoback 0 : Rem          -- Turn off Amos automatic screen buffer system 
  127.    Bob Update Off : Rem      -- (not really needed)    
  128.    Sprite Update Off : Rem   -- (not really needed)     
  129.    Make Mask : Rem           -- Must do this, or no masks will be created.  
  130.    '                         -- Unlike Amos bobs, for speed this is not 
  131.    '                         -- automatic when the bobs are first drawn.
  132.    Reserve Pbobs _BOBS : Rem -- The total amount of bobs being used 
  133.    Pbob Dbuf True : Rem      -- Double buffering to be used on Pbobs   
  134.    '
  135.    'Trim bobs to best fit 
  136.    If _BOB_SIZE=32
  137.       PH=30
  138.    Else 
  139.       PH=15
  140.    End If 
  141.    '
  142.    For K=1 To _BOBS
  143.       Pbob Height K,PH : Rem set height of each Pbob
  144.    Next K
  145.    '
  146. End Proc
  147. '
  148. Procedure _SET_UP
  149.    '
  150.    '-- This procedure is for setting up the demo.   
  151.    '-- No PowerBob commands can be found here.
  152.    '
  153.    '-- Well apart from "VALUE=Xscrn Mouse", 
  154.    '-- which is a cut down Amos for "VALUE=X screen(X mouse)".  
  155.    '
  156.    '-- All these Amos commands are fully documented in the Amos user guide  
  157.    '
  158.    Screen Open 0,640,200,4,Hires : Curs Off : Flash Off : Cls 0
  159.    Ink 2,0 : Pen 2 : Paper 0
  160.    '
  161.    Reserve Zone 4 : Rem -- Define 4 option boxes to be set up later    
  162.    '
  163.    Centre "Please Use The Mouse To Select"
  164.    Print At(30,12);Zone$(Border$("SMALL",3),1)+Cright$+" or  "+Zone$(Border$("LARGE",3),2)+Cright$+" BALLS"
  165.    '
  166.    Repeat 
  167.       MZ=Mouse Zone
  168.    Until MZ>0 and Mouse Click
  169.    '
  170.    _BOB_SIZE=MZ*16
  171.    '
  172.    Print At(26,15);"Number of balls   ";Zone$(Border$("OK",3),3)
  173.    '
  174.    _BOBS=8
  175.    '
  176.    Set Zone 4,128-64,118 To 196,128
  177.    Hslider 130-64,118 To 194,128,64,_BOBS,1
  178.    Text 98-64,126,Str$(_BOBS)+" "
  179.    '
  180.    Repeat 
  181.       If Mouse Zone=4 and Mouse Key
  182.          LAST=_BOBS
  183.          _BOBS=Max(2,Min(128,Xscr Mouse-129+64))/2
  184.          If LAST<>_BOBS
  185.             Hslider 130-64,118 To 194,128,64,_BOBS,1
  186.             Text 98-64,126,"   " : Text 98-64,126,Str$(_BOBS)
  187.          End If 
  188.       End If 
  189.    Until Mouse Key and Mouse Zone=3
  190.    '
  191. End Proc
  192.